home *** CD-ROM | disk | FTP | other *** search
/ PC World 2006 September / PCWorld_2006-09_cd.bin / v cisle / samurize / samurize_1.64.exe / Scripts / ExternalIP.vbs < prev    next >
Text File  |  2004-11-13  |  3KB  |  118 lines
  1. '--------------------------------------------------------------------------------
  2. '  ExternalIP.vbs (v1.5)
  3. '--------------------------------------------------------------------------------
  4. '
  5. ' Retreives your external IP address from http://checkip.dyndns.org/ (this is 
  6. ' useful for computers behind routers and firewalls)
  7. '
  8. ' Changes in v1.5
  9. '
  10. ' - used regular expressions to pick up IP (removes the <!-- proxy --> bug)
  11. '
  12. ' Changes in v1.4
  13. '
  14. ' - internet connection detected (thanks AdamC)
  15. '
  16. '
  17. ' Changes in v1.3
  18. '
  19. ' - international version returns 2 IP addresses if you have multiple NICs in your
  20. '   computer - fixed to only show one. (Thanks Rasman)
  21. '
  22. ' Changes in v1.2
  23. '
  24. ' - uses new URL to save bandwidth
  25. ' - Old script was actually returning proxy IP, not actual IP!
  26. '
  27. ' Changes in v1.1:
  28. '
  29. ' - Added error messages
  30. ' - Hid relevant functions from Samurize 0.85b
  31. '
  32. '                                -NeM
  33. '--------------------------------------------------------------------------------
  34.  
  35. Const CheckConnected      = False                            ' Whether you want the script to check if its connected to the internet
  36.                                                             ' Either True of False
  37.  
  38.  
  39. Function getExternalIP ()
  40.     dim htmlResult,re,matches
  41.     
  42.     'Check that Computer is connected to the internet
  43.     Connected = IsConnectible("checkip.dyndns.org","","")    
  44.  
  45.     if Connected = True OR CheckConnected = False then
  46.         htmlResult = ReturnHTML("http://checkip.dyndns.org/")
  47.         Set re = New RegExp
  48.         With re
  49.             .Pattern = "\d*\.\d*\.\d*\.\d*"
  50.             .IgnoreCase = True
  51.             .Global = True
  52.         End With
  53.         Set matches = re.Execute(htmlResult)
  54.         if matches.count > 0 then
  55.             getexternalip = matches.item(0).value
  56.         Else
  57.             getExternalIP = "ERROR"
  58.         End If
  59.         
  60.     Else
  61.         getExternalIP = "Offline"
  62.     End If
  63.  
  64. End Function
  65.  
  66. Private Function ReturnHTML(sURL)
  67.     Dim objXMLHTTP,HTML
  68.     Set objXMLHTTP = CreateObject("Microsoft.XMLHTTP")
  69.     objXMLHTTP.Open "GET", sURL, False
  70.     objXMLHTTP.Send
  71.     HTML = objXMLHTTP.responseBody
  72.     Set objRS = CreateObject("ADODB.Recordset")
  73.     objRS.Fields.Append "txt", 200, 45000, &H00000080
  74.     objRS.Open
  75.     objRS.AddNew
  76.     objRS.Fields("txt").AppendChunk HTML
  77.     ReturnHTML = objRS("txt").Value
  78.     objRS.Close
  79.     Set objRS = Nothing
  80.     Set objXMLHTTP = Nothing
  81. End Function
  82.  
  83. ' This was done by someone on the forums which I copied, and can I find that post again can I heck
  84. ' So who every you are thanks for the cold.
  85. Private Function IsConnectible(sHost,iPings,iTO)
  86.     ' Works an "all" WSH versions
  87.     ' sHost is a hostname or IP
  88.  
  89.     ' iPings is number of ping attempts
  90.     ' iTO is timeout in milliseconds
  91.     ' if values are set to "", then defaults below used
  92.  
  93.      If iPings = "" Then iPings = 2
  94.      If iTO = "" Then iTO = 750
  95.     
  96.      Const OpenAsDefault    = -2
  97.      Const FailIfNotExist   =  0
  98.      Const ForReading       =  1
  99.     
  100.      Set oShell = CreateObject("WScript.Shell")
  101.      Set oFSO = CreateObject("Scripting.FileSystemObject")
  102.      sTemp = oShell.ExpandEnvironmentStrings("%TEMP%")
  103.      sTempFile = sTemp & "\runresult.tmp"
  104.  
  105.      oShell.Run "%comspec% /c ping -n " & iPings & " -w " & iTO & " " & sHost & ">" & sTempFile, 0 , True
  106.     
  107.      Set fFile = oFSO.OpenTextFile(sTempFile, ForReading, FailIfNotExist, OpenAsDefault)
  108.  
  109.      sResults = fFile.ReadAll
  110.      fFile.Close
  111.      oFSO.DeleteFile(sTempFile)
  112.     
  113.      Select Case InStr(sResults,"TTL=")
  114.        Case 0 IsConnectible = False
  115.        Case Else IsConnectible = True
  116.      End Select
  117. End Function
  118.